COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN
C00026 ENDMK
C⊗;
BEGIN


SPECIAL ?&FILENAME, ?&CURFN, ?&ECNT, ?&RCNT, ?&SPECS, ?&FNS, ?&X?&, ?&Y?&;
SPECIAL SCNVAL, ?&SCANVAL, ?&SCANTYPE, ?&IDTYPE, ?&STRTYPE, ?&NUMTYPE, ?&DELIMTYPE;
SPECIAL BASE, IBASE, BLANK, CR, VT;


DEFINE ?&NEXT PREFIX, ?&NEXTDELIM PREFIX;


FEXPR MLISP (L);
	BEGIN
	NEW FILE, TIM, EX;
	NEW ?&FILENAME, ?&CURFN, ?&ECNT, ?&RCNT, ?&SPECS, ?&FNS,
		?&X?&, ?&Y?&, ?&SCANVAL, ?&SCANTYPE;
	IF NOT ?&ISDEVICE(CAR L) THEN L ← 'DSK?: CONS L;
	IF ATOM (?&FILENAME ← L[2]) THEN FILE ← ?&FILENAME
	ELSE FILE ← CAR ?&FILENAME;
	INC(EVAL <'INPUT, CAR L, ?&FILENAME>, NIL);
	IF L ← CDDR L THEN
		IF GET('PPRINTQ, 'FSUBR) THEN
			?&Y?& ← EVAL <'OUTPUT, 'DSK?:,
				FILE CONS (IF CAR L THEN 'LAP ELSE 'LSP)>
		ELSE PRINTSTR "USE MLISPC" ALSO GO EXIT;
	CSYM ?&M000;
	PRINTSTR TERPRI TERPRI "*****";
	TIM ← TIME();
	IF (EX ← MTRANS()) AND EX ≠ '(PROG NIL) THEN
		?&FNS ← PRINTTY('RESTART) CONS ?&FNS
		ALSO PUTPROP('RESTART, <'LAMBDA, NIL, EX>, 'EXPR);
	TIM ← (TIME() - TIM) / 1000;
	PRINTSTR TERPRI "*****";
	CSYM G0000;
	IF ?&SCANVAL NEQ '?. THEN ?&ERROR("END OF PROGRAM NOT A PERIOD");
	PRINTSTR(TIM CAT " SECONDS TRANSLATION TIME");
	PRINTSTR(?&ECNT CAT " ERRORS DETECTED");
	PRINTSTR(?&RCNT CAT " FUNCTIONS REDEFINED");
	TERPRI INC(NIL, T);
	IF NULL L THEN
		(IF GET('RESTART, 'EXPR) THEN RESTART()) ALSO GO EXIT;
	?&Y?& ← NIL;
	MAPCAR(FUNCTION(LAMBDA (?&X?&);
		IF NOT(?&X?& ε ?&Y?&) THEN PUTPROP(?&X?&, T, 'SPECIAL)
			ALSO ?&Y?& ← ?&X?& CONS ?&Y?&), 
		?&SPECS);
	PRINTSTR "SPECIAL DECLARATIONS:";
	TERPRI TERPRI PRINT (?&SPECS ← ?&Y?&);
	MAPCAR(FUNCTION(LAMBDA (?&X?&);
		IF GET(?&X?&, 'SPECIAL) THEN
			?&WARNING("FUNCTION ALSO DECLARED SPECIAL", ?&X?&)), 
		?&FNS ← REVERSE ?&FNS);
	IF CAR L THEN PRINTSTR ("COMPILING ONTO " CAT FILE CAT ".LAP")
	ELSE PRINTSTR ("PRINTING ONTO " CAT FILE CAT ".LSP");
	TERPRI OUTC(T, TERPRI NIL);
	BASE ← 8;
	IF CAR L THEN 
		MAPCAR(FUNCTION(LAMBDA (X);
			BEGIN
			COMPILEFUN(X);
			IF REMPROP(PRINTTY(X), 'EXPR) THEN PUTPROP(X, T, '?*EXPR);
			END), ?&FNS)
	ELSE 	BEGIN
		L ← NULL CDR(L) OR L[2];
		PPRINT('(SPECIAL) CONS ?&SPECS, NIL);
		PPRINT('(?*FEXPR ?*LEXPR) CONS ?&FNS, NIL);
		PPRINT('(MACRO) CONS ?&FNS, L);
		PPRINT('(EXPR FEXPR) CONS ?&FNS, L);
		END;
	BASE ← 10;
EXIT;	OUTC(NIL, T);
	INC(NIL, T);
	RETURN TERPRI '?*?*?*?-END?-OF?-RUN?-?*?*?*;
	END;


EXPR MTRANS ();
	BEGIN
	NEW EX;
	?&SPECS ← ?&FNS ← NIL;
	?&ECNT ← ?&RCNT ← 0;
	?&CURFN ← 'TOP?-LEVEL;
	?&X?& ← T;
	SCANSET();
	?&SCAN();
	EX ← ?&EXPR();
	SCANRESET();
	RETURN EX;
	END;


EXPR MEVAL ();
	BEGIN
	NEW MODE, ?&X?&;
	PRINC TERPRI "WELCOME TO MLISP. TYPE `HELP;' FOR HELP.";
	SCANSET();
	MODE ← 'M;
	WHILE T DO
		BEGIN
		PRINC TERPRI TERPRI MODE;
		?&X?& ← IF MODE EQ 'M THEN MTRANS() ELSE READ();
		IF ?&X?& EQ 'LISP THEN SCANRESET() ALSO MODE ← 'L
		ELSE IF ?&X?& EQ 'MLISP THEN SCANSET() ALSO MODE ← 'M
		ELSE IF ?&X?& EQ 'HELP THEN
			BEGIN
			EVAL '(INC (INPUT HELP SYS?: (HELP.MLI)) NIL);
			PRINTSTR READ();
			INC(NIL, T);
			END
		ELSE IF MODE EQ 'M THEN
			SCANRESET() ALSO
			ERRSET(PRINT EVAL ?&X?&, T) ALSO
			SCANSET()
		ELSE ERRSET(PRINT EVAL ?&X?&, T);
		END;
	END;


EXPR ?&EXPR ();
	?&HIER(0, ?&SIMPEX());


EXPR ?&HIER (RBP, EX);
	IF ?&SCANTYPE EQ ?&NUMTYPE OR ?&SCANTYPE EQ ?&STRTYPE THEN
		?&ERROR("ILLEGAL INFIX OPERATOR")
	ELSE IF RBP GREATERP ?&BINDINGPOWER(?&SCANVAL, '?&LEFT) THEN EX
	ELSE ?&HIER1(RBP, EX, ?&BINDINGPOWER(?&SCANVAL, '?&RIGHT));


EXPR ?&HIER1 (RBP, EX, RBP1);
	?&HIER(RBP, ?&TINFIX(?&ADVANCE(?&SCANVAL),
		?&NEXTDELIM '?⊗, EX, ?&HIER(RBP1, ?&SIMPEX())));


EXPR ?&SIMPEX ();
	LAMBDA (EX); 
		IF ?&NEXTDELIM '?[ THEN 
			<'?&INDEX, EX, 'LIST CONS
				?&ARGS('?], "ILLEGAL INDEX EXPRESSION")>
		ELSE EX;
       (IF ?&ID() THEN
		?&TFNCALL(?&ADVANCE(?&SCANVAL))
	ELSE IF ?&SCANTYPE EQ ?&NUMTYPE THEN
		?&ADVANCE(?&SCANVAL)
	ELSE IF GET(?&SCANVAL, '?&RESWORD) THEN 
		IF ?&NEXT 'BEGIN THEN
			'PROG CONS ?&TDECL(NIL) CONS ?&EXPRLIST()
		ELSE IF ?&NEXT 'IF THEN
			'COND CONS ?&TCOND(?&EXPR())
		ELSE IF ?&NEXT 'FOR THEN
			?&TFOR()
		ELSE IF ?&NEXT 'WHILE THEN
			?&TWHILE(?&QEXPR())
		ELSE IF ?&NEXT 'DO THEN
			?&TDO('(QUOTE PROG2), ?&QEXPR(), 'DO)
		ELSE IF ?&NEXT 'COLLECT THEN
			?&TDO('(QUOTE APPEND), ?&QEXPR(), 'COLLECT)
		ELSE IF ?&NEXT 'LAMBDA THEN
			?&TLAMBDA(T)
		ELSE IF ?&NEXT 'DEFINE THEN
			?&TDEFINE()
		ELSE IF ?&NEXT 'COMMENT THEN
			?&SEMISKIP() ALSO ?&SCAN() ALSO ?&SIMPEX()
		ELSE IF GET(?&SCANVAL, '?&FNTYPE) THEN
			?&TFN(?&ADVANCE(?&SCANVAL), ?&ADVANCE(?&SCANVAL))
		ELSE IF ?&SCANVAL EQ 'OCTAL THEN
			?&OCTALNUM()
		ELSE IF ?&SCANVAL EQ 'INLINE THEN
			?&INLINECODE()
		ELSE ?&ERROR("ILLEGAL RESERVED WORD BEGINNING AN EXPRESSION")
	ELSE IF GET(?&SCANVAL, '?&PREFIX) THEN
		?&TPREFIX(?&ADVANCE(?&SCANVAL), ?&NEXTDELIM '?⊗)
	ELSE IF ?&SCANVAL EQ '?' THEN
		?&ADVANCE(<'QUOTE, SREAD()>)
	ELSE IF ?&NEXTDELIM '?( THEN
		?&TPAREN(?&EXPR())
	ELSE IF ?&NEXTDELIM '?< THEN 
		'LIST CONS ?&ARGS('?>, "ILLEGAL EXPRESSION IN LIST BRACKETS")
	ELSE IF ?&SCANTYPE EQ ?&STRTYPE THEN
		?&ADVANCE(<'QUOTE, ?&SCANVAL>)
	ELSE ?&ERROR("ILLEGAL SYMBOL BEGINNING A SIMPLE EXPRESSION"));


EXPR ?&TPREFIX (FN, VOP);
	?&TP1(FN, VOP, ?&HIER(?&BINDINGPOWER(FN, '?&RIGHT), ?&SIMPEX()));


EXPR ?&TP1 (FN, VOP, EX);
	IF FN EQ 'PLUS THEN EX
	ELSE IF FN EQ 'DIFFERENCE AND (FN ← 'MINUS) AND NUMBERP EX
		AND NOT VOP THEN MINUS EX
	ELSE IF VOP THEN <'?&VECTOR, T, <'QUOTE, FN>, EX, NIL>
	ELSE <FN, EX>;


EXPR ?&TINFIX (FN, VOP, X, Y);
	IF FN EQ '?← THEN 
		IF VOP THEN <'?&DECOMPOSE, X, Y>
		ELSE IF ATOM X THEN <'SETQ, X, Y>
		ELSE IF CAR X EQ '?&INDEX THEN ?&TREPLACE(X[2], X[3], Y, GENSYM())
		ELSE IF ATOM CAR X THEN <'STORE, X, Y>
		ELSE ?&ERROR("ILLEGAL ASSIGNMENT TO  " CAT X)
	ELSE IF VOP THEN <'?&VECTOR, NIL, <'QUOTE, FN>, X, Y>
	ELSE IF Y EQ 1 AND FN EQ 'PLUS THEN <'ADD1, X>
	ELSE IF Y EQ 1 AND FN EQ 'DIFFERENCE THEN  <'SUB1, X>
	ELSE IF GET(FN, '?&ASSOC) AND NOT ATOM(X) AND FN EQ CAR(X) THEN X @ <Y>
	ELSE <FN, X, Y>;


EXPR ?&TDECL (L);
	IF ?&NEXT 'NEW THEN ?&TDECL(L @ ?&VARS('?;, NIL, NIL))
	ELSE IF ?&NEXT 'SPECIAL THEN ?&TDECL(PROG2(?&VARS('?;, T, NIL), L))
	ELSE L;


EXPR ?&EXPRLIST ();
	BEGIN
	NEW EX, L, X;
LOOP;	IF EX ← ?&EXPR() THEN L ← EX CONS L;
	X ← ?&NEXTDELIM '?; ;
	IF ?&NEXT 'END THEN RETURN REVERSE L
	ELSE IF X THEN GO LOOP
	ELSE ?&ERROR("MISSING SEMICOLON AFTER EXPRESSION");
	END;


EXPR ?&TCOND (EX);
	IF ?&NEXT 'THEN THEN ?&TC1(EX CONS ?&TALSO(?&EXPR()))
	ELSE ?&ERROR("ILLEGAL EXPRESSION AFTER IF");


EXPR ?&TC1 (L);
	IF ?&NEXT 'ELSE THEN 
		IF ?&NEXT 'IF THEN L CONS ?&TCOND(?&EXPR())
		ELSE <L, T CONS ?&TALSO(?&EXPR())>
	ELSE <L>;


EXPR ?&TALSO (EX);
	IF ?&NEXT 'ALSO THEN EX CONS ?&TALSO(?&EXPR())
	ELSE <EX>;


EXPR ?&TFOR ();
	<'?&FOR, <'QUOTE, ?&FORCLAUSE()>,
		 <'QUOTE, IF ?&NEXT 'DO THEN 'PROG2
			  ELSE IF ?&NEXT 'COLLECT THEN 'APPEND
			  ELSE IF ?&NEXTDELIM '?; THEN ?&ADVANCE(?&SCANVAL)
			  ELSE ?&ERROR("EXPECTED DO, COLLECT OR ; IN FOR-LOOP")>,
		 ?&QEXPR(), 
		 IF ?&NEXT 'UNTIL THEN ?&QEXPR() ELSE '(QUOTE NIL)>;


EXPR ?&FORCLAUSE ();
	((IF ?&NEXT 'NEW THEN 'NEW ELSE 'OLD)
		CONS (	IF ?&ID() THEN ?&ADVANCE(?&SCANVAL)
			ELSE ?&ERROR("NON-IDENTIFIER OR PREFIX AFTER FOR"))
		CONS (	IF ?&NEXT 'IN THEN <'IN, ?&EXPR()>
			ELSE IF ?&NEXT 'ON THEN <'ON, ?&EXPR()>
			ELSE IF ?&NEXTDELIM '?← THEN <'?←, <'?&RANGE, ?&EXPR(), 
				IF ?&NEXT 'TO THEN ?&EXPR()
				ELSE ?&ERROR("ILLEGAL LOWER LIMIT IN FOR-LOOP"), 
				IF ?&NEXT 'BY THEN ?&EXPR()
				ELSE 1>>
			ELSE ?&ERROR("MISSING IN, ON, OR ← AFTER CONTROL VARIABLE IN FOR-LOOP")))
	CONS (	IF ?&NEXT 'FOR THEN ?&FORCLAUSE()
		ELSE NIL);


EXPR ?&TDO (FN, EX, X);
	IF ?&NEXT 'UNTIL THEN <'?&DO, FN, EX, ?&QEXPR()>
	ELSE ?&ERROR("EXPECTED UNTIL IN " CAT X CAT "-UNTIL EXPRESSION");


EXPR ?&TWHILE (EX);
	IF ?&NEXT 'DO THEN <'?&WHILE, '(QUOTE PROG2), EX, ?&QEXPR()>
	ELSE IF ?&NEXT 'COLLECT THEN <'?&WHILE, '(QUOTE APPEND), EX, ?&QEXPR()>
	ELSE ?&ERROR("EXPECTED DO OR COLLECT IN WHILE EXPRESSION");


EXPR ?&TDEFINE ();
	DO	BEGIN
		NEW VAL, TYP;
		IF (TYP ← ?&SCANTYPE) NEQ ?&IDTYPE
		    AND ?&SCANTYPE NEQ ?&DELIMTYPE THEN
			?&ERROR("ILLEGAL SYMBOL BEING DEFINED");
		VAL ← ?&ADVANCE(?&SCANVAL);
		IF ?&NEXT 'PREFIX THEN ?&MAKPREFIX(VAL);
		IF (?&SCANTYPE EQ ?&IDTYPE AND ?&SCANVAL NEQ 'DIFFERENCE)
		    OR (?&SCANTYPE EQ ?&DELIMTYPE AND NOT(?&SCANVAL ε '(?, ?;)))
			THEN PUTPROP(?&SCANVAL, TYP, '?&TRANSTYPE)
			ALSO PUTPROP(?&ADVANCE(?&SCANVAL), VAL, '?&TRANS);
		IF ?&NUMB(VAL, '?&LEFT) THEN 
			?&NUMB(VAL, '?&RIGHT)
				OR ?&ERROR("MISSING RIGHT BINDING POWER");
		END
	UNTIL NOT ?&NEXTDELIM '?, ;


EXPR ?&NUMB (VAL, IND);
	IF ?&SCANTYPE EQ ?&NUMTYPE THEN
		?&ADVANCE(PUTPROP(VAL, ?&SCANVAL, IND))
	ELSE IF ?&NEXT 'DIFFERENCE THEN 
		IF ?&SCANTYPE EQ ?&NUMTYPE THEN
			?&ADVANCE(PUTPROP(VAL, MINUS ?&SCANVAL, IND))
		ELSE ?&ERROR("ILLEGAL BINDING POWER");


EXPR ?&TFN (IND, ?&CURFN);
	BEGIN
	NEW L;
	?&FNCHECK(?&CURFN);
	PUTPROP(?&CURFN, L ← ?&TLAMBDA(NIL), IND);
	IF IND EQ 'EXPR THEN LENGTH L[2] EQ 1 AND ?&MAKPREFIX(?&CURFN)
	ELSE IF IND EQ 'FEXPR THEN PUTPROP(?&CURFN, T, '?*FEXPR)
	ELSE IF IND EQ 'LEXPR THEN
		IF LENGTH L[2] EQ 1 THEN
			PUTPROP(?&CURFN, <'LAMBDA, L[2,1], L[3]>, 'EXPR)
			ALSO PUTPROP(?&CURFN, T, '?*LEXPR)
		ELSE ?&ERROR("LEXPRS MUST HAVE EXACTLY ONE ARGUMENT, NOT " CAT L[2])
	ELSE NIL;
	?&FNS ← ?&CURFN CONS ?&FNS;
	END;


EXPR ?&FNCHECK (X);
	IF GETL(X, '(EXPR FEXPR SUBR FSUBR MACRO)) THEN ?&RCNT ← ?&RCNT+1
		ALSO ?&WARNING("FUNCTION REDEFINED", X)
	ELSE PRINTTY(X);


EXPR ?&MAKPREFIX (FN);
	BEGIN
	GET(FN, '?&RIGHT) OR PUTPROP(FN, 1000, '?&RIGHT);
	GET(FN, '?&LEFT)  OR PUTPROP(FN, -1, '?&LEFT);
	PUTPROP(FN, T, '?&PREFIX);
	END;


EXPR ?&TLAMBDA (ALLOW);
	IF ?&NEXTDELIM '?( THEN ?&TL1(?&VARS('?), ?&NEXT 'SPECIAL, T), ALLOW)
	ELSE ?&ERROR("'(' NEEDED FOR LAMBDA VARIABLES");


EXPR ?&TL1 (L, ALLOW);
	IF ?&NEXTDELIM '?; THEN ?&TL2(<'LAMBDA, L, ?&EXPR()>, ALLOW)
	ELSE ?&ERROR("';' NEEDED AFTER LAMBDA VARIABLES");


EXPR ?&TL2 (EX, ALLOW);
	IF ALLOW AND ?&NEXTDELIM '?; THEN 
		IF ?&NEXTDELIM '?( THEN
			EX CONS ?&ARGS('?), "ILLEGAL LAMBDA ARGUMENT")
		ELSE ?&ERROR("'(' NEEDED FOR LAMBDA ARGUMENTS")
	ELSE EX;


EXPR ?&VARS (TERMIN, ISSPEC, ALLOW);
	IF ?&NEXTDELIM TERMIN THEN NIL
	ELSE ?&TID(ISSPEC) CONS ?&VAR1(TERMIN, ISSPEC, ALLOW);


EXPR ?&VAR1 (TERMIN, ISSPEC, ALLOW);
	IF ?&NEXTDELIM '?, THEN 
		?&TID(ALLOW AND ?&NEXT 'SPECIAL OR NOT ALLOW AND ISSPEC)
			CONS ?&VAR1(TERMIN, ISSPEC, ALLOW)
	ELSE IF ?&NEXTDELIM TERMIN THEN NIL
	ELSE ?&ERROR("ILLEGAL PROG OR LAMBDA VARIABLE");


EXPR ?&ARGS (TERMIN, MSG);
	IF ?&NEXTDELIM TERMIN THEN NIL
	ELSE ?&EXPR() CONS ?&ARG1(TERMIN, MSG);


EXPR ?&ARG1 (TERMIN, MSG);
	IF ?&NEXTDELIM '?, THEN ?&EXPR() CONS ?&ARG1(TERMIN, MSG)
	ELSE IF ?&NEXTDELIM TERMIN THEN NIL
	ELSE ?&ERROR(MSG);


EXPR ?&TID (ISSPEC);
	IF ?&ID() THEN ISSPEC AND ?&SPECS ← ?&SCANVAL CONS ?&SPECS
		ALSO ?&ADVANCE(?&SCANVAL)
	ELSE ?&ERROR("NON-IDENTIFIER OR PREFIX USED IN FORMAL VARIABLE LIST");


EXPR ?&TFNCALL (X);
	IF ?&NEXTDELIM '?( THEN X CONS ?&ARGS('?), "ILLEGAL ARGUMENT")
	ELSE X;


EXPR ?&TREPLACE (X, L, Y, G);
	<'PROG2, <'SETQ, X, <'?&REPLACE, X, L, <'SETQ, G, Y>>>, G>;


EXPR ?&TPAREN (EX);
	IF ?&NEXTDELIM '?) THEN EX
	ELSE ?&ERROR("ILLEGAL PARENTHESIZED EXPRESSION");


EXPR ?&OCTALNUM ();
	BEGIN
	NEW IBASE;
	IBASE ← 8;
	?&SCAN();
	IF ?&SCANTYPE EQ ?&NUMTYPE THEN RETURN ?&ADVANCE(?&SCANVAL)
	ELSE ?&ERROR("RESERVED WORD OCTAL NOT FOLLOWED BY A NUMBER");
	END;


EXPR ?&INLINECODE ();
	BEGIN
	NEW BASE, IBASE;
	BASE ← IBASE ← 8;
	IF ATOM(?&SCANVAL ← SREAD()) OR CAR(?&SCANVAL) NEQ 'LAP THEN
		?&ERROR("INLINE CODE DOES NOT BEGIN WITH: (LAP <NAME> <IND>)");
	?&FNCHECK(?&SCANVAL[2]);
	IF ?&Y?& THEN 
		BEGIN
		OUTC(T, NIL);
		PRINT ?&SCANVAL;
	L; 	IF PRINT READ() THEN GO L
		ELSE OUTC(TERPRI NIL, NIL);
		END
	ELSE EVAL ('?&LAP CONS CDR ?&SCANVAL);
	?&SCAN();
	END;


EXPR ?&ERROR (MSG);
	BEGIN
	NEW PAGE, LINE, IFILE, OFILE, X;
	?&ECNT ← ?&ECNT+1;
	PAGE ← CAR PGLINE();
	LINE ← CDR PGLINE();
	OFILE ← OUTC(NIL, NIL);
	TERPRI NIL;
	PRINTSTR ("*** ERROR IN " CAT ?&CURFN);
	PRINTSTR ("*** " CAT MSG);
	PRINTSTR ("*** CURRENT SYMBOL IS " CAT ?&SCANVAL);
	IF NULL (IFILE ← INC(NIL, NIL)) THEN GO MORE;
	PRINTSTR ("*** LINE NUMBER " CAT LINE CAT '?/ CAT PAGE);
	PRINTSTR "*** TYPE E TO EDIT YOUR FILE, C TO CONTINUE";
LOOP; 	IF (X ← SREAD()) EQ 'E THEN READCH() EQ CR AND READCH()
		ALSO PRINTSTR VT
		ALSO SWAP(?&FILENAME, PAGE, LINE)
	ELSE IF X EQ 'C THEN GO MORE
	ELSE PRINTSTR ("TYPE E OR C, NOT  " CAT X)
		ALSO GO LOOP;
MORE; 	PRINTSTR "*** SKIPPING TO NEXT SEMICOLON";
	INC(IFILE, NIL);
	OUTC(OFILE, NIL);
	?&SEMISKIP();
	END;


EXPR ?&WARNING (MSG, X);
	BEGIN
	NEW OFILE;
	OFILE ← OUTC(NIL, NIL);
	PRINC TERPRI "*** WARNING ***, ";
	PRINC MSG;
	PRINC ": ";
	PRINTSTR X;
	OUTC(OFILE, NIL);
	RETURN X;
	END;


EXPR ?&SEMISKIP ();
	WHILE NOT(?&SCANVAL EQ '?; AND ?&SCANTYPE EQ ?&DELIMTYPE) DO ?&SCAN();


EXPR ?&SCAN ();
	IF (?&SCANTYPE ← SCAN()) EQ ?&IDTYPE THEN ?&SCAN1(INTERN SCNVAL)
	ELSE IF ?&SCANTYPE EQ ?&DELIMTYPE THEN ?&SCAN1(INTERN ASCII SCNVAL)
	ELSE ?&SCANVAL ← SCNVAL;


EXPR ?&SCAN1 (X);
	IF GET(X, '?&TRANS) AND ?&X?& THEN
		?&SCANTYPE ← GET(X, '?&TRANSTYPE) ALSO
		?&SCANVAL  ← GET(X, '?&TRANS)
	ELSE ?&SCANVAL ← X;


EXPR ?&NEXT (X);
	IF ?&SCANVAL EQ X THEN ?&ADVANCE(T);


EXPR ?&NEXTDELIM (X);
	IF ?&SCANVAL EQ X AND ?&SCANTYPE EQ ?&DELIMTYPE THEN ?&ADVANCE(T);


EXPR ?&ADVANCE (X);
	PROG2(?&SCAN(), X);


EXPR ?&ID ();
	?&SCANTYPE EQ ?&IDTYPE
		AND NOT(GET(?&SCANVAL, '?&RESWORD) OR GET(?&SCANVAL, '?&PREFIX));


EXPR ?&BINDINGPOWER (X, IND);
	IF X ← GET(X, IND) THEN X ELSE GET('?&DEFAULT, IND);


EXPR ?&QEXPR ();
	<'QUOTE, ?&EXPR()>;


EXPR ?&ISDEVICE (X);
	(ATOM X AND CAR LAST(EXPLODEC X) EQ '?:)
		OR (NOT ATOM X AND NOT ATOM CDR X);


FEXPR ?&LAP (X);
	BEGIN
	NEW LOC, CONLIST, GEN, REMOB;
	SPECIAL LOC, CONLIST, GEN, REMOB, KLIST, BPORG, LAPORG;
	GEN ← GENSYM();
	CONLIST ← <NIL>;
	LOC ← BPORG;
LOOP; 	IF NULL (?&SCANVAL ← SREAD()) THEN GO EXIT
	ELSE IF ATOM ?&SCANVAL THEN GO A
	ELSE GO I;
A; 	DEFSYM(?&SCANVAL, LOC);
	GO LOOP;
I; 	DEPOSIT(LOC, GWD(?&SCANVAL));
	?&BPCHECK();
	GO LOOP;
EXIT;	DEFSYM(GEN, LOC);
	MAPCAR(FUNCTION(LAMBDA (Y);
		BEGIN
		KLIST ← (Y CONS LOC) CONS KLIST;
		DEPOSIT(LOC, GWD(Y));
		?&BPCHECK();
		END),
		CDR CONLIST);
	PUTPROP(CAR X, NUMVAL BPORG, X[2]);
	BPORG ← LOC;
	MAPCAR(FUNCTION(LAMBDA (Y);
		IF REMPROP(Y, 'SYM) AND GET(Y, 'UNDEF) THEN
			?&ERROR("UNDEFINED LABEL USED IN INLINE CODE: " CAT Y)),
		REMOB);
	END;


EXPR ?&BPCHECK ();
	IF (LOC ← LOC+1) ≥ LAPORG THEN ?&ERROR("BINARY PROGRAM SPACE EXCEEDED");


END.